{-# OPTIONS -fno-warn-missing-signatures #-}
{-# LANGUAGE NamedFieldPuns, FlexibleContexts, NoMonomorphismRestriction #-}
{- |
Module      :  Loader
Description :  <optional short text displayed on contents page>
Copyright   :  (c) Sergey Sichevskiy 2013
License     :  BSD3

Maintainer  :  s.sichevskij@gmal.com
Stability   :  experimental
Portability :  portable


-}

module Loader
  ( getContext
  )
    where

import Types

import Loader.Parser
import Loader.InputFile    ( parseInputFile )
import Loader.ModelFlux    ( parseModelFlux )
import Control.Monad.Error ( runErrorT, liftIO )

import qualified Quadrature as Q


{--
test fn = runErrorT $ parseConfigFile fn (testParser_1)

testParser_1 :: ReaderT (ConfigParser, FilePath) (ErrorT SCPError IO) (Int, Double, Double->Double)
testParser_1 = do
  x <- get "EXTERNAL_CONDITIONS" "ExposureTime"

  y <- parseConfigFile "sim.cfg" testParser_2

  f <- parseFuncFile "db/dev/dat/mr.dat"

  return (x,y,f)

testParser_2 = do
  return 11.0
--}

--
getContext fn = do

   rv <- runErrorT $ parseConfigFile fn mainParser

   case rv of
       Left  e -> error  $ show e
       Right c -> return c

-- Главный парсер для анализа файла конфигурации.
mainParser = do

  aos <- objParser
  int <- intParser
  fit <- fitParser
  res <- resParser
  iel <- ielParser
  flx <- flxParser int

--  ps  <- get "FITTING_METHOD" "initial_point"

  let  c = Context { response   = res
                   , extinction = iel
                   , integrator = int
                   , fitmethod  = fit
                   , modelflux  = flx
                   }

--  return c
  return (aos,undefined,c)

--  return (aos,ps,c)

-- 
objParser = do
  liftIO $ putStrLn "\nParsing the Objects section...\n" 

  fn <- get "OBJECTS" "filePath"
  tp <- get "OBJECTS" "contentType"

  r <- parseInputFile tp fn

  return r

--
flxParser i = do
  liftIO $ putStrLn "\nParsing the Model Flux section...\n"

  tp <- get "MODEL_FLUX" "modelType"

  parseModelFlux tp i

-- Парсер для анализа данных о законе межзвездного поглощения.
ielParser = do
  liftIO $ putStrLn "\nParsing the Interstellar Extinction Law section...\n"

  get "INTERSTELLAR_EXTINCTION_LAW" "ielaw" >>= parseBFuncFile

-- Парсер для анализа данных о "Интеграторе".
intParser = do
  liftIO $ putStrLn "\nParsing the Integrator section...\n"

  b <- get "INTEGRATOR" "bounds"
  h <- get "INTEGRATOR" "step"

  return $ Integrator { bound=b, step=h, quad=Q.quad b h }

-- Парсер для анализа данных о "Фиттере".
fitParser = do
  liftIO $ putStrLn "\nParsing the Fitting Method Section...\n"

  a <- get "FITTING_METHOD" "absolute_tolerance"
  r <- get "FITTING_METHOD" "relative_tolerance"
  i <- get "FITTING_METHOD" "maximum_number_of_iterations"
--  p <- get "FITTING_METHOD" "initial_point"

  return $ FittingMethod { absTolerance=a, relTolerance=r, maxIterations=i } --, initialPoint=p }

-- Парсер для анализа данных о инструментальных кривых реакции
-- фотометрических обзоров.
resParser = do
  liftIO $ putStrLn "\nParsing the Responses section...\n"

  twomass_J <- get "RESPONSE" "J_2MASS" >>= parseBFuncFile
  twomass_H <- get "RESPONSE" "H_2MASS" >>= parseBFuncFile
  twomass_K <- get "RESPONSE" "K_2MASS" >>= parseBFuncFile

  wbvr_W    <- get "RESPONSE" "W_WBVR"  >>= parseBFuncFile
  wbvr_B    <- get "RESPONSE" "B_WBVR"  >>= parseBFuncFile
  wbvr_V    <- get "RESPONSE" "V_WBVR"  >>= parseBFuncFile
  wbvr_R    <- get "RESPONSE" "R_WBVR"  >>= parseBFuncFile

  return $ Resp { 
                -- 2MASS
                  j_twomass = twomass_J
                , h_twomass = twomass_H
                , k_twomass = twomass_K
                -- WBVR
                , w_wbvr = wbvr_W
                , b_wbvr = wbvr_B
                , v_wbvr = wbvr_V
                , r_wbvr = wbvr_R
                }
